home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / rkpls301.zip / RKPDEMO3.ZIP / SAMPLE1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-04  |  5KB  |  205 lines
  1. Program Sample1;
  2.  
  3. {
  4.  This is a demonstration programme using RkPlus.
  5.  It uses 2 registration levels (0 and 1).
  6.  If a Level 1 key has expired, it will be treated as Level 0.
  7.  If a Level 0 key has expired, it will be treated as Unregistered.
  8.  This is a very simple programme that doesn't actually do anything, but it
  9.  should demonstrate some of what can be done with RkPlus.  It uses
  10.  a key file (SAMPLE.RKP) which can be created by GenFile or Register.
  11.  
  12.  Sample1 uses the Rkp3Enc unit to cause RkPlus to use the new version 3.x
  13.  keys.
  14. }
  15.  
  16.  
  17. Uses
  18.   Crt,
  19.   RkPlus,
  20.   Rkp3Enc;
  21.  
  22.  
  23. Const
  24.   MonthNames : Array[1..12] of String[3]
  25.   = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  26.  
  27.  
  28. Var
  29.   kc : Char;
  30.   Owner : Array[0..16] of Char;
  31.   Prog  : Array[0..5] of Char;
  32.   Ver   : Real;
  33.  
  34.  
  35. Procedure BadRegBeep;
  36.  
  37. Begin
  38.   Sound(1200);
  39.   Delay(200);
  40.   Sound(600);
  41.   Delay(200);
  42.   Sound(1200);
  43.   Delay(200);
  44.   Sound(600);
  45.   Delay(200);
  46.   NoSound;
  47. End;
  48.  
  49.  
  50. Procedure NotRegBeep;
  51.  
  52. Begin
  53.   Sound(600);
  54.   Delay(200);
  55.   Sound(1200);
  56.   Delay(200);
  57.   NoSound;
  58. End;
  59.  
  60.  
  61. Procedure DoView;
  62.  
  63. Begin
  64.   WriteLn('Sample data :');
  65.   WriteLn;
  66.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  67.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  68.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  69.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  70.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  71.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  72.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  73.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  74. End;
  75.  
  76.  
  77. Procedure DoCalc;
  78.  
  79. Begin
  80.   If Rkp.Registered then Begin
  81.     Write('The calculated result is ');
  82.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  83.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  84.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  85.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  86.   End Else
  87.     WriteLn('Only available in registered version!');
  88. End;
  89.  
  90.  
  91. Procedure DoTest;
  92.  
  93. Begin
  94.   If Rkp.Registered then Begin
  95.     If (Rkp.Level > 0) then Begin
  96.       Write('Performing tests...');
  97.       Delay(300);
  98.       WriteLn;
  99.       WriteLn('All tests passed.');
  100.     End Else
  101.       WriteLn('Not available in demo version!');
  102.   End Else
  103.     WriteLn('Only available in registered version!');
  104. End;
  105.  
  106.  
  107. Begin
  108.   If Not RkpOK then Begin
  109.     WriteLn('Unexpected Error ',RkpError,'!');
  110.     Halt(255);
  111.   End;
  112.   If BadSystemDate then Begin
  113.     WriteLn('You must correctly set your system clock to run Sample1!');
  114.     BadRegBeep;
  115.     Halt(1);
  116.   End;
  117.   Owner := 'ArgleBarbWotsLeeb';
  118.   Prog := 'Sample';
  119.   Ver := 1.0;
  120.   SetOwnerCode(Owner,SizeOf(Owner));
  121.   SetProgCode(Prog,SizeOf(Prog));
  122.   SetVerCode(Ver,SizeOf(Ver));
  123.   SetKeyFile('Sample');
  124.   GetRegInfo;
  125.   Write('Sample1');
  126.   If Not RkpOK then
  127.     WriteLn(' [invalid]')
  128.   Else If Rkp.Registered and (Rkp.Level > 0) then
  129.     WriteLn(' [registered]')
  130.   Else If Rkp.Registered then
  131.     WriteLn(' [demo]')
  132.   Else
  133.     WriteLn(' [unregistered]');
  134.   WriteLn('Sample of RkPlus methods 1 and 2 (using version 3.x/compatible keys)');
  135.   WriteLn('See RKPLUS.DOC for more info');
  136.   WriteLn;
  137.   If (RkpError = InvalidFile) or (RkpError = InvalidKey) then Begin
  138.     WriteLn(KeyFileName,' has been altered!');
  139.     BadRegBeep;
  140.     Halt(1);
  141.   End Else If (RkpError = ExpiredKey) then Begin
  142.     If (Rkp.Level > 0) then Begin
  143.       WriteLn('Your registration key has expired!');
  144.       WriteLn('You will be given DEMO access.');
  145.       NotRegBeep;
  146.       Rkp.Level := 0;
  147.     End Else Begin
  148.       WriteLn('Your demo key has expired!');
  149.       WriteLn('You will be given UNREGISTERED access.');
  150.       NotRegBeep;
  151.       Rkp.Registered := False;
  152.     End;
  153.   End Else If Rkp.Registered then Begin
  154.     If (Rkp.Level > 0) then Begin
  155.       WriteLn('This version of Sample1 is registered to ',Rkp.Name1);
  156.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  157.         WriteLn('This registration will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  158.       WriteLn('Thank you for registering!');
  159.     End Else Begin
  160.       WriteLn('This version of Sample1 is a limited use demo for ',Rkp.Name1);
  161.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  162.         WriteLn('This demo will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  163.       WriteLn('Don''t forget to register!');
  164.     End;
  165.   End Else If Not RkpOK then Begin
  166.     WriteLn('Unexpected error ',RkpError,'!');
  167.     Halt(255);
  168.   End Else Begin
  169.     WriteLn('This version of Sample1 is unregistered.');
  170.     NotRegBeep;
  171.     Delay(500);
  172.   End;
  173.   WriteLn;
  174.   WriteLn('Sample1 Menu');
  175.   WriteLn;
  176.   WriteLn('[V]iew sample data');
  177.   Write('[C]alculate');
  178.   If Not Rkp.Registered then
  179.     WriteLn('  (only available in registered version)')
  180.   Else
  181.     WriteLn;
  182.   Write('[T]est results');
  183.   If Not Rkp.Registered then
  184.     WriteLn('  (only available in registered version)')
  185.   Else If (Rkp.Level <= 0) then
  186.     WriteLn('  (not available in demo version)')
  187.   Else
  188.     WriteLn;
  189.   WriteLn;
  190.   Write('Selection : ');
  191.   kc := UpCase(ReadKey);
  192.   WriteLn;
  193.   WriteLn;
  194.   Case kc of
  195.   'V' :
  196.     DoView;
  197.   'C' :
  198.     DoCalc;
  199.   'T' :
  200.     DoTest;
  201.   Else
  202.     WriteLn('Invalid selection!');
  203.   End;
  204. End.
  205.